home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / internet / webtbl.zip / TBL.PAS < prev   
Pascal/Delphi Source File  |  1996-04-23  |  3KB  |  118 lines
  1. program tbl;
  2.  
  3. var
  4.  tbor,
  5.  tsize,
  6.   j,
  7.   cols : byte;
  8.   width : array[1..12] of word;
  9.   wide,
  10.   s,
  11.   sub,
  12.   title : string;
  13.   nowrap,
  14.   valign,
  15.   align : string[8];
  16.   f : text;
  17.   lines : word;
  18.  
  19.  
  20. {$I readparm.prc }
  21. {$I exists.prc }
  22. {$I readline.prc }
  23. {$I getfield.prc }
  24. {$I value.prc }
  25.  
  26. procedure usage;
  27. begin
  28.     writeln('tbl input.txt second.txt config');
  29.     halt;
  30. end;
  31.  
  32. procedure cfg;
  33. var cfg : string[12];
  34. begin
  35.    if paramstr(3)<>'' then cfg := paramstr(3)
  36.                       else cfg := 'tbl.cfg';
  37.    cols := value(read_params(cfg,'cols'));
  38.    wide := read_params(cfg,'width');
  39.    title := read_params(cfg,'title');
  40.    tsize := value(read_params(cfg,'title_size'));
  41.    tbor  := value(read_params(cfg,'table_border'));
  42.    align  := read_params(cfg,'align');
  43.    nowrap  := read_params(cfg,'nowrap');
  44.    valign := read_params(cfg,'valign');
  45.    sub := readline(1,paramstr(2));
  46. end;
  47.  
  48. procedure header;
  49. var sub:text;
  50.       s:string;
  51. begin
  52.     writeln('<html>');
  53.     writeln('<h',tsize,'>');
  54.     writeln(title);
  55.     writeln('</h',tsize,'>');
  56.     writeln('<p>');
  57.     if file_exists(paramstr(2)) then
  58.     begin
  59.       assign(sub,paramstr(2));
  60.       reset(sub);
  61.       repeat
  62.           readln(sub,s);
  63.           writeln(s);
  64.       until eof(sub);
  65.       close(sub);
  66.     end;
  67.     writeln('</p>');
  68.     writeln('<TABLE BORDER="',tbor,'" ALIGN="'+align+'" NOWRAP="'+nowrap+'"><TR>');
  69. end;
  70.  
  71. begin
  72.     if paramcount<2 then usage;
  73.     cfg;
  74.     assign(f,paramstr(1));
  75.     reset(f);
  76.     assign(output,'');
  77.     rewrite(output);
  78.  
  79.     header;
  80.  
  81.     readln(f,s);  {do the header line}
  82.     for j:=1 to cols do
  83.       begin
  84.           if j=1 then
  85.           writeln('<TD VALIGN="'+valign+'" ALIGN="'+align+
  86.           '" COLSTART="',j,'" WIDTH="'+get_field(1,wide)+'"><B>'+
  87.           get_field(1,s)+'</B></TD>')
  88.           else
  89.           if j=cols then {last one!}
  90.           writeln('<TD COLSTART="',cols,'" width="'+get_field(cols,wide)+'"><b>'+get_field(cols,s)+'</b></TD><TR><TR>')
  91.           else {must be one in the middle}
  92.           writeln('<TD COLSTART="',j,'" width="'+get_field(j,wide)+'"><b>'+get_field(j,s)+'</b></TD>');
  93.       end;
  94.       writeln;
  95.  
  96.     lines := 1;
  97.     repeat            { now do the data }
  98.         readln(f,s);
  99.         inc(lines);
  100.         for j:=1 to cols do
  101.           begin
  102.               if j=1 then writeln('<TD COLSTART="1">'+get_field(1,s)+'</TD>')
  103.               else
  104.               if j=cols then writeln('<TD COLSTART="',cols,'">'+
  105.               get_field(cols,s)+'</TD></TR><TR>')
  106.               else writeln('<TD COLSTART="',j,'">'+get_field(j,s)+'</TD>');
  107.           end;
  108.           writeln;
  109.     until eof(f);
  110.  
  111.     close(f);
  112.     writeln('</TABLE>');
  113.     writeln('<p>');
  114.     writeln('</p>');
  115.     writeln('</html>');
  116.     close(output);
  117. end.
  118.